home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / TPAINT2.LZH / CONVERT.PAS < prev    next >
Pascal/Delphi Source File  |  1986-03-15  |  4KB  |  95 lines
  1.            (* **************************************************** *)
  2.            (*                                                      *)
  3.            (*                     CONVERT.PAS                      *)
  4.            (*                                                      *)
  5.            (*     This Program will convert screens with headers,  *)
  6.            (*   such as those saved by PC Paint (uncompressed),    *)
  7.            (*   Polaroid Palette, and BASIC's BSave into files     *)
  8.            (*   that can be displayed directly in a Turbo Pascal   *)
  9.            (*   program. The basic idea is to load the file into   *)
  10.            (*   a Buffer and then move the bytes beyond the        *)
  11.            (*   header file to the color screen.                   *)
  12.            (*     The usual offset is 7 (PC Paint) or 8 (Polaroid) *)
  13.            (*   bytes.                                             *)
  14.            (*     This procedure may fail if the file size is less *)
  15.            (*   than the array size declared for ScreenType. In    *)
  16.            (*   that case EOF will be encountered before expected. *)
  17.            (*   ScreenType may be declared to be a smaller array   *)
  18.            (*   size (say, 16,191 bytes) and the program should    *)
  19.            (*   then work.                                         *)
  20.            (*   How nice it is to be able to use a paint program   *)
  21.            (*   to create screens for your Turbo Pascal programs!  *)
  22.            (*                                                      *)
  23.            (*                (c)    Donald L. Pavia                *)
  24.            (*                       Depatment of Chemistry         *)
  25.            (*    March 1986         Western Washington University  *)
  26.            (*                       Bellingham, Washington 98225   *)
  27.            (*                                                      *)
  28.            (* **************************************************** *)
  29.  
  30.  
  31. program ConvertScreens;
  32.  
  33. {----------------------------------------------------------------------------}
  34. {$I LoadSave.Lib}
  35. {----------------------------------------------------------------------------}
  36.  
  37. var   FilName,NewName    : str255;
  38.       Color,Pal,Bckg     : integer;
  39.       ScrnMode,Save,Wait : char;
  40.       Buffer : ScreenType;
  41.  
  42. procedure ConvertScreen (FileName : str255; OffSet : byte);
  43.  
  44.   var  DisplayFile : ScreenFile;
  45.  
  46.   begin
  47.        assign (DisplayFile,FileName);
  48.        reset  (DisplayFile);
  49.        read   (DisplayFile,Buffer);
  50.        close  (DisplayFile);
  51.  
  52.        move (Buffer[Offset],Screen,16200);
  53.   end;
  54. {----------------------------------------------------------------------------}
  55.  
  56. begin
  57.      clrscr; writeln;
  58.      write (' Enter FileName of Disk File : '); readln (FilName);
  59.      writeln;
  60.      write (' (1) Med Res or (2) HiRes ? : ');  readln (ScrnMode);
  61.  
  62.      if ScrnMode = '1' then begin
  63.         write (' Choice of Palette (0..3) ? : '); readln (Pal);
  64.         write (' Background Color (0..15) ? : '); readln (Bckg);
  65.         writeln end;
  66.      if ScrnMode = '2' then begin
  67.         write (' Choice of HiResColor (0..15) ? :  '); readln (Color);
  68.         writeln end;
  69.  
  70.      write (' Give Byte Offset [0 (Turbo), 7 (PCPaint,BSave), 8 (PSaver)] : ');
  71.      read (Offset); writeln; writeln;
  72.  
  73.      write (' Save Image to Disk with New Name? Y/N ? :  ');
  74.      read (Kbd,Save); writeln;
  75.  
  76.      if UpCase(Save) = 'Y' then
  77.            begin  write ('       New FileName : '); read (NewName)  end;
  78.  
  79.      writeln;
  80.      writeln (' Press <RETURN> to See Result !!!! ');
  81.      write   (' Then Press Again to End Program   ');
  82.      read (Kbd,Wait);
  83.  
  84.      case ScrnMode of
  85.        '1' : begin Graphcolormode; Palette (Pal); GraphBackground (Bckg) end;
  86.        '2' : begin HiRes; HiResColor (Color) end;
  87.      end;
  88.  
  89.      ConvertScreen (FilName,OffSet); read (Kbd,Wait);
  90.  
  91.      if UpCase(Save) = 'Y' then SaveScreen (NewName);
  92.  
  93.      TextMode (c80); clrscr;
  94. end.
  95.